home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / acasol.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  5.0 KB  |  171 lines
  1. /* acasol.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal value[200000];
  33. } blank_;
  34.  
  35. #define blank_1 blank_
  36.  
  37. /* Subroutine */ int acasol_()
  38. {
  39.     /* System generated locals */
  40.     integer i_1, i_2;
  41.     doublereal d_1, d_2;
  42.     complex q_1;
  43.  
  44.     /* Local variables */
  45.     extern /* Subroutine */ int cdiv_();
  46.     static integer iord, jord;
  47.     extern /* Subroutine */ int copy8_();
  48.     static integer i, j, k;
  49.     static doublereal ximag;
  50.     static integer locnn;
  51.     static doublereal xreal;
  52.     extern /* Subroutine */ int cmult_();
  53.     extern integer indxx_();
  54. #define nodplc ((integer *)&blank_1)
  55. #define cvalue ((complex *)&blank_1)
  56.     static integer loc;
  57.  
  58.  
  59. /*     this routine evaluates the response of the adjoint circuit by */
  60. /* doing a forward/backward substitution step using the transpose of the 
  61. */
  62. /* circuit equation coefficient matrix. */
  63.  
  64. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  65. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  66. /* spice version 2g.6  sccsid=blank 3/15/83 */
  67.  
  68. /*  evaluates adjoint response by doing forward/backward substitution on 
  69. */
  70. /*  the transpose of the y matrix */
  71.  
  72. /*  forward substitution */
  73.  
  74.     i_1 = cirdat_1.nstop;
  75.     for (i = 2; i <= i_1; ++i) {
  76.     loc = i;
  77.     iord = nodplc[tabinf_1.icswpf + i - 1];
  78. L10:
  79.     loc = nodplc[tabinf_1.irpt + loc - 1];
  80.     if (nodplc[tabinf_1.irowno + loc - 1] >= i) {
  81.         goto L15;
  82.     }
  83.     j = nodplc[tabinf_1.irowno + loc - 1];
  84.     jord = nodplc[tabinf_1.icswpf + j - 1];
  85.     cmult_(&blank_1.value[tabinf_1.lynl + loc - 1], &blank_1.value[
  86.         tabinf_1.imynl + loc - 1], &blank_1.value[tabinf_1.lvn + jord 
  87.         - 1], &blank_1.value[tabinf_1.imvn + jord - 1], &xreal, &
  88.         ximag);
  89.     blank_1.value[tabinf_1.lvn + iord - 1] -= xreal;
  90.     blank_1.value[tabinf_1.imvn + iord - 1] -= ximag;
  91.     goto L10;
  92. L15:
  93.     jord = nodplc[tabinf_1.irswpf + i - 1];
  94.     locnn = indxx_(&jord, &iord);
  95.     cdiv_(&blank_1.value[tabinf_1.lvn + iord - 1], &blank_1.value[
  96.         tabinf_1.imvn + iord - 1], &blank_1.value[tabinf_1.lynl + 
  97.         locnn - 1], &blank_1.value[tabinf_1.imynl + locnn - 1], &
  98.         blank_1.value[tabinf_1.lvn + iord - 1], &blank_1.value[
  99.         tabinf_1.imvn + iord - 1]);
  100. /* L20: */
  101.     }
  102.  
  103. /*  backward substitution */
  104.  
  105.     i = cirdat_1.nstop;
  106. L30:
  107.     --i;
  108.     if (i <= 1) {
  109.     goto L60;
  110.     }
  111.     iord = nodplc[tabinf_1.icswpf + i - 1];
  112.     loc = i;
  113. L35:
  114.     loc = nodplc[tabinf_1.irpt + loc - 1];
  115. /* L40: */
  116.     if (nodplc[tabinf_1.irowno + loc - 1] != i) {
  117.     goto L35;
  118.     }
  119. L50:
  120.     loc = nodplc[tabinf_1.irpt + loc - 1];
  121.     if (loc == 0) {
  122.     goto L30;
  123.     }
  124.     j = nodplc[tabinf_1.irowno + loc - 1];
  125.     jord = nodplc[tabinf_1.icswpf + j - 1];
  126.     cmult_(&blank_1.value[tabinf_1.lynl + loc - 1], &blank_1.value[
  127.         tabinf_1.imynl + loc - 1], &blank_1.value[tabinf_1.lvn + jord - 1]
  128.         , &blank_1.value[tabinf_1.imvn + jord - 1], &xreal, &ximag);
  129.     blank_1.value[tabinf_1.lvn + iord - 1] -= xreal;
  130.     blank_1.value[tabinf_1.imvn + iord - 1] -= ximag;
  131.     goto L50;
  132.  
  133. /*  reorder solution vector */
  134.  
  135. L60:
  136.     i_1 = cirdat_1.nstop;
  137.     for (i = 1; i <= i_1; ++i) {
  138.     j = nodplc[tabinf_1.irswpr + i - 1];
  139.     k = nodplc[tabinf_1.icswpf + j - 1];
  140.     blank_1.value[tabinf_1.ndiag + i - 1] = blank_1.value[tabinf_1.lvn + 
  141.         k - 1];
  142.     blank_1.value[tabinf_1.ndiag + i + cirdat_1.nstop - 1] = 
  143.         blank_1.value[tabinf_1.imvn + k - 1];
  144. /* L70: */
  145.     }
  146.     copy8_(&blank_1.value[tabinf_1.ndiag], &blank_1.value[tabinf_1.lvn], &
  147.         cirdat_1.nstop);
  148.     copy8_(&blank_1.value[tabinf_1.ndiag + 1 + cirdat_1.nstop - 1], &
  149.         blank_1.value[tabinf_1.imvn], &cirdat_1.nstop);
  150.     i_1 = cirdat_1.nstop;
  151.     for (i = 2; i <= i_1; ++i) {
  152.     i_2 = tabinf_1.lcvn + i - 1;
  153.     d_1 = blank_1.value[tabinf_1.lvn + i - 1];
  154.     d_2 = blank_1.value[tabinf_1.imvn + i - 1];
  155.     q_1.r = d_1, q_1.i = d_2;
  156.     cvalue[i_2].r = q_1.r, cvalue[i_2].i = q_1.i;
  157. /* L120: */
  158.     }
  159.     i_1 = tabinf_1.lcvn;
  160.     cvalue[i_1].r = (float)0., cvalue[i_1].i = (float)0.;
  161.  
  162. /*  finished */
  163.  
  164.     return 0;
  165. } /* acasol_ */
  166.  
  167. #undef cvalue
  168. #undef nodplc
  169.  
  170.  
  171.